Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue46/packages/DinoSource.Zip/PalettePopup.pas

Pascal/Delphi Source File | 1998-10-28 | 5.7 KB | 208 lines

unit PalettePopup;

interface

procedure Register;

implementation

uses
  Forms, CommonStuff, Classes, Menus, SysUtils, Dialogs;

resourcestring
  SPages = '&Component palette page menu items'; //Palette menu items toggle option

const
  SRegPages = 'Tab page menu items'; //Registry string
  SProperties = 'Configure2'; //Palette Propertites menu item
  SPaletteMenuOnClick = 'PaletteLocalPopup'; //Palette menu's OnPopup handler

type
  TPalettePopup = class(TObject)
  private
    FProperties,
    FPagesOption: TMenuItem;
    FPaletteList: TList;
    FOldPaletteOnPopup: TNotifyEvent;
  protected
    procedure AddPaletteMenuItems;
    procedure DeletePaletteMenuItems;
    procedure DoPages(Sender: TObject);
    procedure DoClick(Sender: TObject);
    procedure DoPalettePopup(Sender: TObject);
    procedure SetPages(Value: Boolean);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Setup;
    procedure TidyUp;
  end;

constructor TPalettePopup.Create;
begin
  inherited Create;
end;

destructor TPalettePopup.Destroy;
begin
  TidyUp;
  inherited Destroy;
end;

procedure TPalettePopup.Setup;
begin
  //Make list for storing palette menu items
  FPaletteList := TList.Create;
  //Make sure there is an options menu - bear in mind
  //that the other options code might not be being used
  Stuff.AddOptionsItem;
  //Set up component palette page options menu item
  FPagesOption := NewItem(SPages, 0,
    Stuff.Ini.ReadBool(SRegSection, SRegPages, False),
    True, DoPages, 0, '');
  //Insert the menu item
  Stuff.FOptions.Add(FPagesOption);
  //Set the page menu items as appropriate
  SetPages(FPagesOption.Checked);

  //Chain component palette OnPopup event - this may cause problems
  //if someone else chains on to it afterwards, and then we are deleted.
  //The later chainer will be referring to dead code -> AV time

  //Save old OnPopup handler
  FOldPaletteOnPopup := Stuff.FPalettePopup.OnPopup;
  //Warn user if event was already chained
  TestChainedEventHandler(TMethod(FOldPaletteOnPopup).Code,
    Application.MainForm.MethodAddress(SPaletteMenuOnClick));
  //Replace Delphi's event handler with our own
  Stuff.FPalettePopup.OnPopup := DoPalettePopup;
end;

procedure TPalettePopup.TidyUp;
begin
  //Save option state
  Stuff.Ini.WriteBool(SRegSection, SRegPages, FPagesOption.Checked);
  //Delete component palette menu items
  SetPages(False);
  Stuff.FOptions.Free;
  Stuff.FOptions := nil;
  //Unchain the chained event handler
  if Assigned(Stuff.FPalettePopup) then
    Stuff.FPalettePopup.OnPopup := FOldPaletteOnPopup;
  //Tidy up menu list
  FPaletteList.Free;
end;

procedure TPalettePopup.AddPaletteMenuItems;

  procedure AddMenuItem(Menu: TMenuItem);
  begin
    FPaletteList.Add(Menu);
    Stuff.FPalettePopup.Items.Add(Menu);
  end;

var
  Loop: Integer;
  Item: TMenuItem;
begin
  //Slot an About menu item in
  AddMenuItem(NewItem(SAbout, 0, False, True, Stuff.DoAbout, 0, ''));
  //Add a separator
  AddMenuItem(NewLine);
  //Add an item for each palette page
  for Loop := 0 to Stuff.FTabControl.Tabs.Count - 1 do
  begin
    Item := NewItem(Stuff.FTabControl.Tabs[Loop], 0, False, True, DoClick, 0, '');
    Item.RadioItem := True;
    //Give them some group index to make RadioItem property work
    Item.GroupIndex := 57;
    AddMenuItem(Item);
  end;
  //Add a separator
  AddMenuItem(NewLine);
end;

procedure TPalettePopup.DeletePaletteMenuItems;
begin
  //Get rid of palette tab popup menu items
  while FPaletteList.Count <> 0 do
  begin
    TMenuItem(FPaletteList[0]).Free;
    FPaletteList.Delete(0);
  end;
end;

procedure TPalettePopup.DoPages(Sender: TObject);
begin
  //Toggle existence of palette popup menu items
  with Sender as TMenuItem do
  begin
    Checked := not Checked;
    SetPages(Checked)
  end
end;

procedure TPalettePopup.DoClick(Sender: TObject);
var
  NewIndex: Integer;
begin
  //Work out which tab is to be selected
  NewIndex := Stuff.FTabControl.Tabs.IndexOf((Sender as TMenuItem).Caption);
  if NewIndex <> -1 then
  begin
    //Set new tab as active
    Stuff.FTabControl.TabIndex := NewIndex;
    //Ensure it looks like a real click by triggering OnChange event
    Stuff.FTabControl.OnChange(Stuff.FTabControl)
  end
end;

procedure TPalettePopup.DoPalettePopup(Sender: TObject);
begin
  if FPagesOption.Checked then
  begin
    //Because the palette pages may have changed, delete the menu items...
    DeletePaletteMenuItems;
    //... and add new ones
    AddPaletteMenuItems;
    //Put the bullet mark on the currently selected page
    //bearing in mind the About item and the extra new line
    TMenuItem(FPaletteList.Items[Stuff.FTabControl.TabIndex + 2]).Checked := True;
  end;
  //Now make sure Properties lives at the end of the menu like it should
  FProperties := GetComponent(Application.MainForm, SProperties, SGenericError + SProperties) as TMenuItem;
  FProperties.MenuIndex := Stuff.FPalettePopup.Items.Count;
  //Chain onto old OnPopup event handler
  if Assigned(FOldPaletteOnPopup) then
    FOldPaletteOnPopup(Stuff.FPalettePopup)
end;

procedure TPalettePopup.SetPages(Value: Boolean);
begin
  if Value then
    //This extends the local popup menu on the component palette
    AddPaletteMenuItems
  else
    //This deletes the palette menu items
    DeletePaletteMenuItems
end;

var
  PalettePopupObject: TPalettePopup;

procedure Register;
begin
  PalettePopupObject.Setup
end;

initialization
  try
    PalettePopupObject := TPalettePopup.Create
  except
    on E: Exception do
      ShowMessage(SSetupError + ': ' + E.Message)
  end
finalization
  PalettePopupObject.Free
end.